Celestin Apprentice 5/Apprentice-Release5.iso/Source Code/Think Class Libraries/CPixMap.p 1.0/CPixMapPane.p

Text File | 1996-02-04 | 12.3 KB | 443 lines | [TEXT/PJMM]

{****************************************************}
{}
{        CPixMap.p                                                                                                                                                                                                                }
{}
{        SUPERCLASS = CBitMap                                                                                                                                                                    }
{}
{        Copyright © 1996 Patrick C Hew. All rights reserved.                                                                        }
{}
{        Based on CColorBitMap.c Code by John A Love, III                                                                                        }
{        email : [e-mail]                                                                                                                                                                            }
{}
{        Translated from CPixMap.cp Code by Marty R Wachter                                                                        }
{        email : [e-mail]     or [e-mail]                                                                                }
{}
{        The principal focus of the other files is to OVERRIDE the THINK Class Library's    }
{        "CBitMap" and "CBitMapPane" classes to accomodate color.                                                            }
{}
{        The principal foundation of this work rests with Forrest Tanaka 's    Macintosh        }
{        Technical Note #120. Other, though lesser, key points are :                                                            }
{}
{        •    I have introduced a new instance variable of CBitMapPane in my                                        }
{                CColorBitMapPane class which I call "bitsUnderPane ". It becomes very                }
{                useful when dragging objects around , vice having to take a "picture" of                 }
{                the entire window or screen as Symantec 's    Art Class demo does.     I must        }
{                admit , however , that I have not YET    figured out how to update this                        }
{                "bitsUnderPane" CColorBitMap with a change in color depth, for example,        }
{                when using the popular "Switch-A-Roo"     FKEY. Please refer to my Update            }
{                method for further insight. By the way, Update works just fine    with                        }
{                "itsBitMap", the on-th -top CBitMap.                                                                                                                        }
{        •    I have made much more prolific comments throughout the source.                                    }
{                I truly hope that they are sufficient to guide you.                                                                                    }
{}
{        Original Author : John A . Love , III email : [e-mail]                                                                }
{}
{        Revision History:                                                                                                                                                                                        }
{}
{        Version:    1.0 for TCL 1.1.3 (C)                                                                                                                                                }
{        Date:             1993                                                                                                                                                                                                }
{        Author:        John A Love, III     <[e-mail]>                                                                                                            }
{        Notes:            Original release.                                                                                                                                                                }
{}
{        Version:    2.0 for TCL 2.0.3 (C++)                                                                                                                                        }
{        Date:             10 November 1994                                                                                                                                                        }
{        Author:        Marty R Wachter     <[e-mail]> or                                                }
{                                                                                            <[e-mail]>                                                                                            }
{        Notes:            Added support for real C++ in TCL 2.0 by adding proper,                                        }
{                                    constructors, destructors, class definitions, etc… to conform to                }
{                                    the TCL 2.0 changes.                                                                                                                                                    }
{}
{        Version:    1.0 for TCL 1.1.2 (Pascal)                                                                                                                                    }
{        Date:             28 January 1996                                                                                                                                                            }
{        Author:        Patrick C Hew     <[e-mail]>                                                                                }
{        Notes:            Translated from CPixMap.cp.                                                                                                                            }
{}
{****************************************************}


unit CPixmapPane;

interface

    uses
        TCL, MoreTCL, CPixMap;

    type
        DeviceOption = (kDeepestScreen, kLargestAreaScreen);


    type
        CPixMapPane = object(CBitMapPane)

                bitsUnderPane: CPixMap;
                gdOption: DeviceOption;
                currentDepth: Integer;

                { Construct a PixMapPane object.     }
                procedure IPixMapPane (anEnclosure: CView;
                                            aSupervisor: CBureaucrat;
                                            aWidth, aHeight, aHEncl, aVEncl: Integer;
                                            aHSizing, aVSizing: SizingOption;
                                            aBounds: LongRect;
                                            aPixMap: CPixMap;
                                            makePort: Boolean);

                { Destroy a PixMapPane object, resetting all pointers. }
                procedure Free;
                override;

                { Draw a PixMapPane. }
                procedure Draw (var area: Rect);
                override;

                { Returns TRUE if the PixMapPane needs updating to reflect a change in }
                { screen depth. }
                function PixMapsNeedUpdating: Boolean;

                { Returns the screen device specified by gdOption. }
                function GetScreenDevice (var globalRect: Rect): GDHandle;

                { Display and draw a PICT resource in the PixMap. }
                procedure BlitPICTRes (hOrig, vOrig: Integer;
                                            pictID: Integer;
                                            drawIt: Boolean);

            end; { CPixMapPane }

implementation

    uses
        LongQD;


{****************************************************}
{}
{        IPixMapPane                                                                                                                                                                                                        }
{}
{        Construct a PixMapPane object.                                                                                                                                                }
{}
{****************************************************}

    procedure CPixMapPane.IPixMapPane (anEnclosure: CView;
                                    aSupervisor: CBureaucrat;
                                    aWidth, aHeight, aHEncl, aVEncl: Integer;
                                    aHSizing, aVSizing: SizingOption;
                                    aBounds: LongRect;
                                    aPixMap: CPixMap;
                                    makePort: Boolean);

        var
            globalBoundsR: Rect;
            currMaxDevice: GDHandle;
            desktop: RgnHandle;

            thePixMap: CPixMap;
            fi: FailInfo;

        procedure HandleMainBitmapFailure (error: Integer;
                                        message: LongInt);

        begin { HandleMainBitmapFailure }
            ForgetObject(itsBitMap);
            itsBitMap := nil;
        end; { HandleMainBitmapFailure }

        procedure HandleUnderBitmapFailure (error: Integer;
                                        message: LongInt);

        begin { HandleUnderBitmapFailure }
            ForgetObject(bitsUnderPane);
            bitsUnderPane := nil;
            ForgetObject(itsBitMap);
            itsBitMap := nil;
        end; { HandleUnderBitmapFailure }

    begin { IPixMapPane}
        itsBitMap := nil;

        IPanorama(anEnclosure, aSupervisor, aWidth, aHeight, aHEncl, aVEncl, aHSizing, aVSizing);

        bounds := aBounds;
        position.h := bounds.left;
        position.v := bounds.top;

        itsBitmap := nil;
        bitsUnderPane := nil;
        gdOption := kDeepestScreen;

        { Since FrameToGlobalR accesses CPane's hOrigin and vOrigin. }
        Prepare;
        FrameToGlobalR(aBounds, globalBoundsR);

        if not gSystem.hasColorQD then begin
            currentDepth := 1;
        end { if }
        else begin
            currMaxDevice := GetScreenDevice(globalBoundsR);
            if currMaxDevice <> nil then begin
                currentDepth := currMaxDevice^^.gdPMap^^.pixelSize;
            end
            else begin
                FailOSErr(NilGDeviceError);
            end; { else }
        end; { else }

        if aPixMap = nil then begin
            CatchFailures(fi, HandleMainBitmapFailure);

            new(aPixMap);
            aPixMap.IPixMap(Integer(aBounds.right - aBounds.left), Integer(aBounds.bottom - aBounds.top), makePort);
            itsBitmap := aPixMap;

            Success;

        { I "roll my own" bounds within IPixMap: }
        { itsBitMap.SetBoundsOrigin(aBounds.left, aBounds.top); }

        end { if }
        else begin
            itsBitMap := aPixMap;
        end; { else }

        CatchFailures(fi, HandleUnderBitmapFailure);

        new(thePixMap);
        thePixMap.IPixMap(Integer(aBounds.right - aBounds.left), Integer(aBounds.bottom - aBounds.top), makePort);
        bitsUnderPane := thePixMap;

        Success;

        autoRefresh := FALSE;
    end; { IPixMapPane }


{****************************************************}
{}
{        Free                                                                                                                                                                                                                                }
{}
{        Destroy a PixMapPane object, resetting all pointers.                                                                                }
{}
{****************************************************}

    procedure CPixMapPane.Free;

    begin { Free }
        ForgetObject(bitsUnderPane);
        bitsUnderPane := nil;

        { itsBitmap is disposed of in inherited method. }

        inherited Free;
    end; { Free }


{****************************************************}
{}
{        Draw                                                                                                                                                                                                                            }
{}
{        Draw a PixMapPane.                                                                                                                                                                                }
{}
{****************************************************}

    procedure CPixMapPane.Draw (var area: Rect);

        var
            theLBounds, lArea: LongRect;
            theSBounds: Rect;

            ignore: Boolean;

    begin { Draw }
        if itsBitmap <> nil then begin

            if PixMapsNeedUpdating then begin
                    { CPixMap(itsBitMap).Update; }
                if bitsUnderPane <> nil then begin
                        { bitsUnderPane.Update; }
                end; { if }
            end; { if }

            CPixMap(itsBitMap).GetBounds(theLBounds);
            LongToQDRect(theLBounds, theSBounds);
            ignore := SectRect(area, theSBounds, area);

            QDToFrameR(area, lArea);
            CPixMap(itsBitMap).CopyFrom(lArea, lArea, nil);
        end; { if }
    end; { Draw }


{****************************************************}
{}
{        PixMapsNeedUpdating                                                                                                                                                                            }
{}
{        Returns TRUE if the PixMapPane needs updating to reflect a change in                                }
{        screen depth.                                                                                                                                                                                                    }
{}
{****************************************************}

    function CPixMapPane.PixMapsNeedUpdating: Boolean;

        var
            theBoundsRect: LongRect;
            globalBoundsR: Rect;
            newMaxDevice: GDHandle;
            newDepth: Integer;

    begin { PixMapsNeedUpdating }
        if not gSystem.hasColorQD then begin
            PixMapsNeedUpdating := FALSE;
        end { if }
        else begin
            Prepare;

            CPixMap(itsBitMap).GetBounds(theBoundsRect);
            FrameToGlobalR(theBoundsRect, globalBoundsR);

            newMaxDevice := GetScreenDevice(globalBoundsR);
            if newMaxDevice = nil then begin
                PixMapsNeedUpdating := FALSE;
            end { if }
            else begin
                newDepth := newMaxDevice^^.gdPMap^^.pixelSize;
                if newDepth > currentDepth then begin
                    currentDepth := newDepth;
                    PixMapsNeedUpdating := TRUE;
                end { if }
                else begin
                    PixMapsNeedUpdating := FALSE;
                end; { else }
            end; { else }

        end; { else }
    end; { PixMapsNeedUpdating }


{****************************************************}
{}
{        GetScreenDevice                                                                                                                                                                                            }
{}
{        Returns the screen device specified by gdOption.                                                                                            }
{}
{****************************************************}

    function CPixMapPane.GetScreenDevice (var globalRect: Rect): GDHandle;

        var
            desktop: RgnHandle;
            area, maxArea: LongInt;
            device, result: GDHandle;
            intersection: Rect;

    begin { GetScreenDevice }
        result := nil;

        { Different screen options require different algorithms. }

        if gdOption = kDeepestScreen then begin
            result := GetMaxDevice(globalRect);
        end { if }
        else if gdOption = kLargestAreaScreen then begin

            { Get a Handle to the first GDevice in the GDevice list. }
            device := GetDeviceList;

            { Keep looping until all GDevices have been checked. }
            maxArea := 0;
            while device <> nil do begin
                if TestDeviceAttribute(device, screenDevice) then begin
                    if TestDeviceAttribute(device, screenActive) then begin
                        { Do screen and passed Rect intersect? }
                        if SectRect(globalRect, device^^.gdRect, intersection) then begin
                            {Yup, so calculate the interection}
                            area := LongInt(intersection.right - intersection.left) * LongInt(intersection.bottom - intersection.top);

                            { Keep track of largest interection area found so far. }
                            if area > maxArea then begin
                                result := device;
                                maxArea := area;
                            end; { if }

                        end; { if }

                        device := GetNextDevice(device);

                    end; { if }
                end; { while }

            end; { else if }
        end; { else }

        if result = nil then begin
        { We're literally OFF the screen, so effect a DeviceOption }
        { = "kLargestAreaScreen" based on the total Desktop region. }
        { Change the object's "gdOption" instance variable since }
        { we may have passed "kLargestAreaScreen": }

            desktop := GetGrayRgn;
            result := GetMaxDevice(desktop^^.rgnBBox);
            if (result <> nil) then begin
                gdOption := kDeepestScreen;
            end; { if }
        end; { if }

        GetScreenDevice := result;
    end; { GetScreenDevice }


{****************************************************}
{}
{        BlitPICTRes                                                                                                                                                                                                            }
{}
{        Display and draw a PICT resource in the PixMap.                                                                                            }
{}
{****************************************************}

    procedure CPixMapPane.BlitPICTRes (hOrig, vOrig: Integer;
                                    pictID: Integer;
                                    drawIt: Boolean);

        var
            r: Rect;
            wide, high: Integer;
            hPic: PicHandle;
            savedAlloc: Boolean;

    begin
        CPixMap(itsBitMap).BeginDrawing;

        {    Get the PICT from a resource. }
        savedAlloc := SetAllocation(kAllocCanFail);
        hPic := GetPicture(pictID);
        savedAlloc := SetAllocation(savedAlloc);
        FailResError;

        HNoPurge(Handle(hPic));

        {    Draw at (0,0), original size. }
        r := hPic^^.picFrame;

        {    Calculate width and height. }
        wide := r.right - r.left;
        high := r.bottom - r.top;

        SetRect(r, 0, 0, wide, high);
        OffsetRect(r, -hOrig, -vOrig);
        EraseRect(r);
        DrawPicture(hPic, r);

        CPixMap(itsBitMap).EndDrawing;

        { We are finished with the picture. }
        HPurge(Handle(hPic));
        ForgetResource(hPic);
        hPic := nil;

        if drawIt then begin
            LongToQDRect(bounds, r);
            Draw(r);
        end; { if }

    end; { BlitPICTRes }

end. { CPixMapPane }